perm filename READIN.F4[OLD,LCS] blob
sn#267294 filedate 1977-03-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE READIN(SOURCE,QUANT,XOUT,LSIZE,FOOGY)
C00008 ENDMK
C⊗;
SUBROUTINE READIN(SOURCE,QUANT,XOUT,LSIZE,FOOGY)
C UNIT GEN. 'READ' = - READ(SOURCE,QUANT,ARRAY,INPUT NCHNS);
C OUTPUTS ARE RDA, RDB, RDC AND RDD. DON'T USE U1, ETC.
C IF SOURCE<100 IT =4TH LETTER. E.G. 4 WILL READ FROM MUSDA (4=D)
C IF SOURCE>100, LAST 2 DIGITS ARE LAST LETTER, 1ST 2 ARE 4TH LETTER.
C E.G. 312 WILL READ FROM MUSCL (3=C, 12=L). 1213 = MUSLM
C LOAD AFTER MUSY,MUSIO,NSCTPY
C MUSIO SHOULD INCLUDE MTA1 CALLS.
COMMON ISAVE
DIMENSION IOUT(2128),XOUT(512),IX(128),IH(5)
DATA IH(1)/' REA'/,IH(2)/'DING '/,IH(4)/' / '/
EQUIVALENCE(IOUT(2001),IX),(K,IH(5))
IF(FOOGY)GO TO 1
C FOOGY>-1 MEANS FIRST TIME THROUGH.
KSIZE=LSIZE/2
C KSIZE IS NUM OF 36-BIT WORDS TO PROCESS.
NAME='MUSAA'
JMP=-1
ISAVE=-1
MTA=0
JA=1
JNM='AAAAA'
K=QUANT-1.
JC=0
IF(SOURCE.LT.100.)GO TO 4
NAME=SOURCE/100.
C GETS # FOR 1ST LETTER.
JC=SOURCE-NAME*100
IF(JC.NE.0)JC=JC-1
C GETS 2ND LETTER.
JNM=NAME-1
GO TO 10
4 IF(SOURCE.GT.0)GO TO 2
MTA=-1
JNM=NAME
CALL MTA1
GO TO 3
2 JNM=SOURCE-1.
10 JNM='MUSAA'+256*JNM
3 KNM=JNM
NAME=JNM+JC*2
JC=K*2
NM2=NAME+JC
JADD=JNM+52-NAME
IF(JC.GT.JADD)NM2=JNM+256+JC-JADD
C IF NAME GOES FROM AZ TO BA
712 IF(NM2.GT.JNM+306)NM2=JNM+512+JC-52-JADD
C IF NAME GOES FROM AZ TO CA
CC IF(K.GT.26)NM2=NAME+256+(K-26)*2
C AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
710 IF(MTA)GO TO 811
711 CALL GETFI2(NAME)
IH(3)=NAME
CALL MESS(IH)
GO TO 810
811 CALL INMTA1(IX(1),128)
IH(3)=IX(3)
CALL MESS(IH)
MCNT=0
C MCNT COUNTS RECORDS READ ON MTA1
ISAVE=-1
IF(IX(1))GO TO 1201
C IF NEG., IT'S THE END OF THE TAPE.
GO TO 2022
810 CALL FASTI2(IX(1),128)
KCNT=2
2022 JSC=IX(1)
JADD=JSC/128
IF(JSC-JADD*128.NE.0)JADD=JADD+1
C JADD IS # OF 128 WD. RECORDS READ.
1022 IF(JA.GT.KSIZE)GO TO 17
610 IF(MTA)GO TO 611
CALL FASTI2(IOUT(JA),JSC)
KCNT=KCNT+JADD
GO TO 612
C LAST WORD IS THROWN AWAY.
611 IF(ISAVE.NE.-2)GO TO 614
CALL MTA1
CALL INMTA1(IX(1),128)
DO 6141 K=1,MCNT
6141 CALL INMTA1(IOUT(JA),JSC)
ISAVE=-1
GO TO 612
C REREADS TAPE UP TO THE RIGHT SPOT.
614 CALL INMTA1(IOUT(JA),JSC)
MCNT=MCNT+1
612 JA=JA+JSC-1
JC=IOUT(JA)
IF(JC)5,1022,6
5 JA=JA-IOUT(JA-1)
6 NAME=NAME+2
IF(NAME.LE.JNM+50)GO TO 27
JNM=JNM+256
C RAISES 'AAAZA' TO 'AABAA'
1017 NAME=JNM
27 IF(NAME.LE.NM2)GO TO 710
1201 NM2=NAME-1
17 CALL ZBIT(IOUT,XOUT)
9 RETURN
1 IF(ISAVE)GO TO 171
ISAVE=-1
IF(NAME.GT.NM2)GO TO 171
IF(MTA.EQ.0)GO TO 271
ISAVE=-2
GO TO 171
C USE 'TAPNEW' TO 'RESET' TAPE.
271 CALL GETFI2(NAME)
CALL USETI(KCNT)
C REREADS KCNT RECORDS OF 128 WDS.
171 JC=JA-1
IF(JMP)7,8,9
7 JC=JC-KSIZE
DO 12 K=1,JC
12 IOUT(K)=IOUT(K+KSIZE)
JA=JC+1
IF(JC.GT.KSIZE)GO TO 17
IF(NAME.LE.NM2)GO TO 610
43 DO 13 K=JC+1,KSIZE
13 IOUT(K)=0
JMP=0
GO TO 17
8 DO 14 K=1,KSIZE
14 IOUT(K)=0
JMP=1
GO TO 17
END
CC
CC
CC NCHNS←2;SRATE←25000;
CC COMPILE;INSTRUMENT XX;
CC READ(P3,P4,F1,P5);OUTA←OUTA+RDB;<CHAN2 DATA IS PUT IN BOTH CHANS.
CC OUTB←OUTB+RDB*P6;END;FINISH;
CC BIGBIT←2;
CC PLAY;XX 0 3 4 3 2 2;FINISH;< MULTS SAMPLES BY 2 IN CH2, READS MUSDA, STEREO
CC DO FILE FOLLOWS:
CC LOA %DMUSY,NSCTPY,READIN,MUSIO↔C 14↔S↔DSK:NOTEY↔